Assignment #3

# SEE modeldata package for new datasets
library(tidyverse)         # for graphing and data cleaning

## Warning: package 'tibble' was built under R version 4.0.4

library(tidymodels)        # for modeling

## Warning: package 'tidymodels' was built under R version 4.0.4

## Warning: package 'dials' was built under R version 4.0.4

## Warning: package 'infer' was built under R version 4.0.4

## Warning: package 'modeldata' was built under R version 4.0.4

## Warning: package 'parsnip' was built under R version 4.0.4

## Warning: package 'recipes' was built under R version 4.0.4

## Warning: package 'rsample' was built under R version 4.0.4

## Warning: package 'tune' was built under R version 4.0.4

## Warning: package 'workflows' was built under R version 4.0.4

## Warning: package 'yardstick' was built under R version 4.0.4

library(stacks)            # for stacking models

## Warning: package 'stacks' was built under R version 4.0.4

library(naniar)            # for examining missing values (NAs)

## Warning: package 'naniar' was built under R version 4.0.4

library(lubridate)         # for date manipulation
library(moderndive)        # for King County housing data

## Warning: package 'moderndive' was built under R version 4.0.4

library(DALEX)             # for model interpretation  

## Warning: package 'DALEX' was built under R version 4.0.4

library(DALEXtra)          # for extension of DALEX

## Warning: package 'DALEXtra' was built under R version 4.0.4

library(patchwork)         # for combining plots nicely
library(dbplyr)            # for SQL query "cheating" - part of tidyverse but needs to be loaded separately
library(mdsr)              # for accessing some databases - goes with Modern Data Science with R textbook

## Warning: package 'mdsr' was built under R version 4.0.4

library(RMySQL)            # for accessing MySQL databases

## Warning: package 'RMySQL' was built under R version 4.0.4

library(RSQLite)           # for accessing SQLite databases

## Warning: package 'RSQLite' was built under R version 4.0.4

#mapping
library(maps)              # for built-in maps
library(sf)                # for making maps using geom_sf
library(ggthemes)          # Lisa added - I like theme_map() for maps :)

#tidytext
library(tidytext)          # for text analysis, the tidy way!

## Warning: package 'tidytext' was built under R version 4.0.4

library(textdata)          

## Warning: package 'textdata' was built under R version 4.0.4

library(reshape2)

## Warning: package 'reshape2' was built under R version 4.0.4

library(wordcloud)         # for wordcloud

## Warning: package 'wordcloud' was built under R version 4.0.4

library(stopwords)

## Warning: package 'stopwords' was built under R version 4.0.4

theme_set(theme_minimal()) # Lisa's favorite theme

library(lime)

## Warning: package 'lime' was built under R version 4.0.4

When you finish the assignment, remove the # from the options chunk at the top, so that messages and warnings aren’t printed. If you are getting errors in your code, add error = TRUE so that the file knits. I would recommend not removing the # until you are completely finished.

Put it on GitHub!

From now on, GitHub should be part of your routine when doing assignments. I recommend making it part of your process anytime you are working in R, but I’ll make you show it’s part of your process for assignments.

Task: When you are finished with the assignment, post a link below to the GitHub repo for the assignment. If you want to post it to your personal website, that’s ok (not required). Make sure the link goes to a spot in the repo where I can easily find this assignment. For example, if you have a website with a blog and post the assignment as a blog post, link to the post’s folder in the repo. As an example, I’ve linked to my GitHub stacking material here.

https://github.com/Niketh27/Advanced_DS_3

Local Interpretable Machine Learning

You are going to use the King County house data and the same random forest model to predict log_price that I used in the tutorial.

data("house_prices")

# Create log_price and drop price variable
house_prices <- house_prices %>% 
  mutate(log_price = log(price, base = 10)) %>% 
  # make all integers numeric ... fixes prediction problem
  mutate(across(where(is.integer), as.numeric)) %>% 
  select(-price)

set.seed(327) #for reproducibility

# Randomly assigns 75% of the data to training.
house_split <- initial_split(house_prices, 
                             prop = .75)
house_training <- training(house_split)
house_testing <- testing(house_split)

ranger_recipe <- 
  recipe(formula = log_price ~ ., 
         data = house_training) %>% 
  step_date(date, 
            features = "month") %>% 
  # Make these evaluative variables, not included in modeling
  update_role(all_of(c("id",
                       "date")),
              new_role = "evaluative")

#define model
ranger_spec <- 
  rand_forest(mtry = 6, 
              min_n = 10, 
              trees = 200) %>% 
  set_mode("regression") %>% 
  set_engine("ranger")

#create workflow
ranger_workflow <- 
  workflow() %>% 
  add_recipe(ranger_recipe) %>% 
  add_model(ranger_spec) 

#fit the model
set.seed(712) # for reproducibility - random sampling in random forest choosing number of variables
ranger_fit <- ranger_workflow %>% 
  fit(house_training)

Tasks:

1. Choose 3 new observations and do the following for each observation:
   

• Construct a break-down plot using the default ordering. Interpret the resulting graph. Which variables contribute most to each observation’s prediction?
  
• Construct a SHAP graph and interpret it. Does it tell a similar story to the break-down plot?
  
• Construct a LIME graph (follow my code carefully). How close is each original prediction to the prediction from the local model? Interpret the result. You can also try using fewer or more variables in the local model than I used in the example.

rf_explain <- 
  explain_tidymodels(
    model = ranger_fit,
    data = house_training %>% select(-log_price), 
    y = house_training %>%  pull(log_price),
    label = "rf"
  )

## Preparation of a new explainer is initiated
##   -> model label       :  rf 
##   -> data              :  16210  rows  20  cols 
##   -> data              :  tibble converted into a data.frame 
##   -> target variable   :  16210  values 
##   -> predict function  :  yhat.workflow  will be used (  default  )
##   -> predicted values  :  No value for predict function target column. (  default  )
##   -> model_info        :  package tidymodels , ver. 0.1.2 , task regression (  default  ) 
##   -> predicted values  :  numerical, min =  5.081823 , mean =  5.66507 , max =  6.726297  
##   -> residual function :  difference between y and yhat (  default  )
##   -> residuals         :  numerical, min =  -0.3147814 , mean =  0.0004295329 , max =  0.2270978  
##   A new explainer has been created! 

house_testing

new_obs1 <- house_testing %>% slice(3333) 
new_obs2 <- house_testing %>% slice(1234) 
new_obs3 <- house_testing %>% slice(4321) 

# Pulls together the data needed for the break-down plot
pp_rf1 <- predict_parts(explainer = rf_explain,
                       new_observation = new_obs1,
                       type = "break_down")
pp_rf2 <- predict_parts(explainer = rf_explain,
                       new_observation = new_obs2,
                       type = "break_down")
pp_rf3 <- predict_parts(explainer = rf_explain,
                       new_observation = new_obs3,
                       type = "break_down")
# Break-down plot
plot(pp_rf1)

plot(pp_rf2)

plot(pp_rf3)

#TODO: Interpret

latitude appears to be the most dominant predictor with all predictions. sqft_living, sqft_above and grade also seem to be important predictors.

rf_shap1 <-predict_parts(explainer = rf_explain,
                        new_observation = new_obs1,
                        type = "shap",
                        B = 10 #number of reorderings - start small
)
rf_shap2 <-predict_parts(explainer = rf_explain,
                        new_observation = new_obs2,
                        type = "shap",
                        B = 10 #number of reorderings - start small
)
rf_shap3 <-predict_parts(explainer = rf_explain,
                        new_observation = new_obs3,
                        type = "shap",
                        B = 10 #number of reorderings - start small
)
plot(rf_shap1)

plot(rf_shap2)

plot(rf_shap3)

Yes, the predictors which are shown to be signifcant are similar in the breakdown plot and the SHAP plot.

set.seed(2)

# NEED these two lines of code always!
# They make sure our explainer is defined correctly to use in the next step
model_type.dalex_explainer <- DALEXtra::model_type.dalex_explainer
predict_model.dalex_explainer <- DALEXtra::predict_model.dalex_explainer

lime_rf1 <- predict_surrogate(explainer = rf_explain,
                             new_observation = new_obs1 %>%
                               select(-log_price), 
                             n_features = 5,
                             n_permutations = 1000,
                             type = "lime")

## Warning: view does not contain enough variance to use quantile binning. Using
## standard binning instead.

## Warning: yr_renovated does not contain enough variance to use quantile binning.
## Using standard binning instead.

## Warning in gower_work(x = x, y = y, pair_x = pair_x, pair_y = pair_y, n =
## NULL, : skipping variable with zero or non-finite range.

lime_rf2 <- predict_surrogate(explainer = rf_explain,
                             new_observation = new_obs2 %>%
                               select(-log_price), 
                             n_features = 5,
                             n_permutations = 1000,
                             type = "lime")

## Warning: view does not contain enough variance to use quantile binning. Using
## standard binning instead.

## Warning: yr_renovated does not contain enough variance to use quantile binning.
## Using standard binning instead.

## Warning in gower_work(x = x, y = y, pair_x = pair_x, pair_y = pair_y, n =
## NULL, : skipping variable with zero or non-finite range.

lime_rf3 <- predict_surrogate(explainer = rf_explain,
                             new_observation = new_obs3 %>%
                               select(-log_price), 
                             n_features = 5,
                             n_permutations = 1000,
                             type = "lime")

## Warning: view does not contain enough variance to use quantile binning. Using
## standard binning instead.

## Warning: yr_renovated does not contain enough variance to use quantile binning.
## Using standard binning instead.

## Warning in gower_work(x = x, y = y, pair_x = pair_x, pair_y = pair_y, n =
## NULL, : skipping variable with zero or non-finite range.

plot(lime_rf1) +
  labs(x = "Variable")

plot(lime_rf2) +
  labs(x = "Variable")

plot(lime_rf3) +
  labs(x = "Variable")

2. Describe how you would use the interpretable machine learning tools we’ve learned (both local and global) in future machine learning projects? How does each of them help you?

These tools help us identify the most important predictors in the model and the nature of their relationship with the response variable which helps us intuitively understand how the predictions are being made which helps us make better model choices.

#Writing:TODO

SQL

You will use the airlines data from the SQL database that I used in the example in the tutorial. Be sure to include the chunk to connect to the database here. And, when you are finished, disconnect. You may need to reconnect throughout as it times out after a while.

con_air <- dbConnect(RMySQL::MySQL(), 
                     dbname = "airlines", 
                     host = "mdsr.cdc7tgkkqd0n.us-east-1.rds.amazonaws.com", 
                     user = "mdsr_public", 
                     password = "ImhsmflMDSwR")

dbListTables(con_air)

## [1] "airports" "carriers" "flights"  "planes"

Tasks: 1. Create a SQL chunk and an equivalent R code chunk that does the following: for 2017 , for each airport (with its name, not code), and month find the total number of departing flights, the average distance of the flight, and the proportion of flights that arrived more than 20 minutes late. In the R code chunk, write this out to a dataset. (HINT: 1. start small! 2. you may want to do the R part first and use it to “cheat” into the SQL code).(New)

• With the dataset you wrote out, create a graph that helps illustrate the “worst” airports in terms of late arrivals. You have some freedom in how you define worst and you may want to consider some of the other variables you computed. Do some theming to make your graph look glamorous (those of you who weren’t in my intro data science class this year may want to watch Will Chase’s Glamour of Graphics talk for inspiration).

• Although your graph was truly inspirational, you’ve been requested to “boil it down to a few numbers.” Some people just don’t appreciate all that effort you put in. And, you need to use the already summarized data that you already pulled in from SQL. Create a table with 6 or fewer rows and 3 or fewer columns that summarizes which airport is the “worst” in terms of late arrivals. Be careful with your calculations. You may consider using the kable, kableExtra, or gt packages to make your table look truly spectacular.

# for 2017 , for each airport (with its name, not code), and month find the total number of departing flights, the average distance of the flight, and the proportion of flights that arrived more than 20 minutes late.

tbl(con_air, "flights") %>% 
  filter(year == 2017) %>% 
  group_by(origin,month) %>% 
  summarise(dep_flights = n(), avg_distance = mean(air_time),  prop_late_over20 = mean(arr_delay > 20)) %>% 
  inner_join( tbl(con_air,"airports"), by = c("origin"="faa")) %>% 
  select(origin: name) %>%  
  show_query()

## Warning in .local(conn, statement, ...): Decimal MySQL column 2 imported as
## numeric

## Warning in .local(conn, statement, ...): Decimal MySQL column 3 imported as
## numeric

## Warning: Missing values are always removed in SQL.
## Use `mean(x, na.rm = TRUE)` to silence this warning
## This warning is displayed only once per session.

## <SQL>
## SELECT `origin`, `month`, `dep_flights`, `avg_distance`, `prop_late_over20`, `name`
## FROM (SELECT `origin`, `month`, `dep_flights`, `avg_distance`, `prop_late_over20`, `name`, `lat`, `lon`, `alt`, `tz`, `dst`, `city`, `country`
## FROM (SELECT `origin`, `month`, COUNT(*) AS `dep_flights`, AVG(`air_time`) AS `avg_distance`, AVG(`arr_delay` > 20.0) AS `prop_late_over20`
## FROM `flights`
## WHERE (`year` = 2017.0)
## GROUP BY `origin`, `month`) `LHS`
## INNER JOIN `airports` AS `RHS`
## ON (`LHS`.`origin` = `RHS`.`faa`)
## ) `q01`

late_airport <- tbl(con_air, "flights") %>% 
  filter(year == 2017) %>% 
  group_by(origin,month) %>% 
  summarise(dep_flights = n(), avg_distance = mean(air_time),  prop_late_over20 = mean(arr_delay > 20)) %>% 
  inner_join( tbl(con_air,"airports"), by = c("origin"="faa")) %>% 
  select(origin: name)

## Warning in .local(conn, statement, ...): Decimal MySQL column 2 imported as
## numeric

## Warning in .local(conn, statement, ...): Decimal MySQL column 3 imported as
## numeric

SELECT `origin`, `month`, `dep_flights`, `avg_distance`, `prop_late_over20`, `name`
FROM (SELECT `origin`, `month`, `dep_flights`, `avg_distance`, `prop_late_over20`, `name`, `lat`, `lon`, `alt`, `tz`, `dst`, `city`, `country`
FROM (SELECT `origin`, `month`, COUNT(*) AS `dep_flights`, AVG(`air_time`) AS `avg_distance`, AVG(`arr_delay` > 20.0) AS `prop_late_over20`
FROM `flights`
WHERE (`year` = 2017.0)
GROUP BY `origin`, `month`) `LHS`
INNER JOIN `airports` AS `RHS`
ON (`LHS`.`origin` = `RHS`.`faa`)
) `q01`

Displaying records 1 - 10

origin	month	dep_flights	avg_distance	prop_late_over20	name
ABE	5	160	90.5125	0.1125	Lehigh Valley Intl
ABE	6	134	90.2985	0.1119	Lehigh Valley Intl
ABE	7	192	90.9167	0.1354	Lehigh Valley Intl
ABE	8	180	88.2333	0.1000	Lehigh Valley Intl
ABE	9	206	91.5825	0.0777	Lehigh Valley Intl
ABE	10	253	94.2806	0.1344	Lehigh Valley Intl
ABE	11	220	95.8773	0.0909	Lehigh Valley Intl
ABE	1	191	96.9581	0.1466	Lehigh Valley Intl
ABE	12	168	98.3869	0.2083	Lehigh Valley Intl
ABE	2	128	93.2656	0.0703	Lehigh Valley Intl

late_airport %>%
  group_by(name) %>% 
  summarise(mean_prop = mean(prop_late_over20)) %>% 
  arrange(desc(mean_prop)) %>% 
  head(30) %>% 
  ggplot(aes(x = mean_prop,
             y = (fct_reorder(name,mean_prop)))) +
  geom_col(fill = "lightblue") +
  scale_x_continuous(expand = c(0,0), 
                     labels = scales::percent) + 
  labs(x = "", y = "", title = "Airports with largest % of departing flights that were more than 20min late")+
  theme_minimal()

## Warning in .local(conn, statement, ...): Decimal MySQL column 1 imported as
## numeric

# - Although your graph was truly inspirational, you've been requested to "boil it down to a few numbers." Some people just don't appreciate all that effort you put in. And, you need to use the already summarized data that you already pulled in from SQL. Create a table with 6 or fewer rows and 3 or fewer columns that summarizes which airport is the "worst" in terms of late arrivals. Be careful with your calculations. You may consider using the `kable`, `kableExtra`, or `gt` packages to make your table look truly spectacular.
library(gt)
gt(late_airport %>%
  group_by(name) %>% 
  summarise(average_late_percentage= mean(prop_late_over20)*100) %>% 
  arrange(desc(average_late_percentage)) %>% 
  head(6))

## Warning in .local(conn, statement, ...): Decimal MySQL column 1 imported as
## numeric

name	average_late_percentage
Sioux Gateway Col Bud Day Fld	62.9650
East Texas Rgnl	50.0000
St. Augustine Airport	36.4340
Southwest Oregon Regional Airport	35.3525
Nantucket Mem	34.9200
Martha\\'s Vineyard	34.1400

2. Come up with your own interesting question that data in the airlines database can help you answer. Write a SQL query and equivalent R code chunk to extract the data you need and create an elegant graph to help answer the question. Be sure to write down the question so it is clear.

Question: What’s the busiest carrier 2010 - 2017?

 carrier_tot_flights <-tbl(con_air, "flights") %>% 
  group_by(carrier) %>% 
  summarise(tot_flights = n()) %>% 
  inner_join( tbl(con_air,"carriers"), by = c("carrier"="carrier")) 

tbl(con_air, "flights") %>% 
  group_by(carrier) %>% 
  summarise(tot_flights = n()) %>% 
  inner_join( tbl(con_air,"carriers"), by = c("carrier"="carrier")) %>% 
  show_query()

## <SQL>
## SELECT `LHS`.`carrier` AS `carrier`, `tot_flights`, `name`
## FROM (SELECT `carrier`, COUNT(*) AS `tot_flights`
## FROM `flights`
## GROUP BY `carrier`) `LHS`
## INNER JOIN `carriers` AS `RHS`
## ON (`LHS`.`carrier` = `RHS`.`carrier`)

SELECT `LHS`.`carrier` AS `carrier`, `tot_flights`, `name`
FROM (SELECT `carrier`, COUNT(*) AS `tot_flights`
FROM `flights`
GROUP BY `carrier`) `LHS`
INNER JOIN `carriers` AS `RHS`
ON (`LHS`.`carrier` = `RHS`.`carrier`)

Displaying records 1 - 10

carrier	tot_flights	name
9E	558065	Endeavor Air Inc.
AA	5216777	American Airlines Inc.
AS	1278114	Alaska Airlines Inc.
B6	1986105	JetBlue Airways
CO	484589	Continental Air Lines Inc.
DL	6469415	Delta Air Lines Inc.
EV	4225846	ExpressJet Airlines Inc.
F9	696776	Frontier Airlines Inc.
FL	969156	AirTran Airways Corporation
HA	588749	Hawaiian Airlines Inc.

carrier_tot_flights %>% 
  ggplot(aes(x = tot_flights, y= fct_reorder(name, tot_flights))) +
  geom_col(fill = "olivedrab2")+ 
  labs( x = "", y = "", title = "Carriers with the most flights (2010 -2017)")+
  theme_minimal()

Function Friday

If you need to revisit the material, it is posted on the moodle page. I’ve tried to add all the necessary libraries to the top, but I may have missed something.

geom_sf() tasks:

Using the example from class that we presented as a baseline (or your own if you really want to be ambitious), try to add the following components to the map of the contiguous United States:

1. Change the color scheme of the map from the default blue (one option could be viridis).
2. Add a dot (or any symbol you want) to the centroid of each state.
3. Add a layer onto the map with the counties.
4. Change the coordinates of the map to zoom in on your favorite state.

Hint: https://www.r-spatial.org/r/2018/10/25/ggplot2-sf-2.html is a useful reference for some of the questions

library(lwgeom)

## Warning: package 'lwgeom' was built under R version 4.0.5

## Linking to liblwgeom 3.0.0beta1 r16016, GEOS 3.9.0, PROJ 7.2.1

## Warning in fun(libname, pkgname): GEOS versions differ: lwgeom has 3.9.0 sf has
## 3.8.0

## Warning in fun(libname, pkgname): PROJ versions differ: lwgeom has 7.2.1 sf has
## 6.3.1

state <- st_as_sf(maps::map("state",plot = FALSE,fill = TRUE))

state <- state %>%
  mutate(area = as.numeric(st_area(state)))

state <- cbind(state, st_coordinates(st_centroid(state)))

## Warning in st_centroid.sf(state): st_centroid assumes attributes are constant
## over geometries of x

## Warning in st_centroid.sfc(st_geometry(x), of_largest_polygon =
## of_largest_polygon): st_centroid does not give correct centroids for longitude/
## latitude data

state %>% 
  filter(ID == "minnesota")

ggplot(data = state) +
  geom_sf(aes(fill = area)) +
  coord_sf(xlim = c(-126, -65),
             ylim = c(24, 50),
             expand = FALSE)+
  geom_point(aes(x = X, y = Y), size = 1, shape = 4)+
  scale_fill_viridis_c(option = "viridis")

county <- st_as_sf(map("county", plot = FALSE, fill = TRUE))

county <- county %>%
  mutate(area = as.numeric(st_area(county)))

ggplot(data = state) +
  geom_sf(aes(fill = area)) +
  geom_sf(data = county, aes(fill = area))+
  coord_sf(xlim = c(-127, -63),
             ylim = c(24, 51),
             expand = FALSE)+
  geom_point(aes(x = X, y = Y), size = 1, shape = 4, color = "white")+
  scale_fill_viridis_c(option = "viridis")

ggplot(data = state) +
  geom_sf(aes(fill = area)) +
  geom_sf(data = county, aes(fill = area))+
  coord_sf(xlim = c(-96.5, -89.5),
             ylim = c(44, 49.5),
             expand = FALSE)+
  geom_point(aes(x = X, y = Y), size = 2, shape = 4, color = "white")+
  scale_fill_viridis_c(option = "viridis")

tidytext tasks:

Now you will try using tidytext on a new dataset about Russian Troll tweets.

Read about the data

These are tweets from Twitter handles that are connected to the Internet Research Agency (IRA), a Russian “troll factory.” The majority of these tweets were posted from 2015-2017, but the datasets encompass tweets from February 2012 to May 2018.

Three of the main categories of troll tweet that we will be focusing on are Left Trolls, Right Trolls, and News Feed. Left Trolls usually pretend to be BLM activists, aiming to divide the democratic party (in this context, being pro-Bernie so that votes are taken away from Hillary). Right trolls imitate Trump supporters, and News Feed handles are “local news aggregators,” typically linking to legitimate news.

For our upcoming analyses, some important variables are:

• author (handle sending the tweet)
• content (text of the tweet)
• language (language of the tweet)
• publish_date (date and time the tweet was sent)

Variable documentation can be found on Github and a more detailed description of the dataset can be found in this fivethirtyeight article.

Because there are 12 datasets containing 2,973,371 tweets sent by 2,848 Twitter handles in total, we will be using three of these datasets (one from a Right troll, one from a Left troll, and one from a News Feed account).

1. Read in Troll Tweets Dataset

# Download the file from github and place in the same project folder
troll_tweets<- read.csv("IRAhandle_tweets_12.csv")

2. Basic Data Cleaning and Exploration

1. Remove rows where the tweet was in a language other than English
2. Report the dimensions of the dataset
3. Create two or three basic exploratory plots of the data (ex. plot of the different locations from which tweets were posted, plot of the account category of a tweet)

# only consider tweets that are in English 
troll_tweets1 <- troll_tweets%>%
  filter(language == 'English')

#possible ideas for exploratory plots
#see where tweets were being posted from
ggplot(troll_tweets1, aes(x = region)) +
  geom_bar() +
  theme(axis.text.x = element_text(angle = 90))

#see what kinds of accounts there are
ggplot(troll_tweets1, aes(x = account_category)) +
  geom_bar() +
  theme(axis.text.x = element_text(angle = 90))

3. Unnest Tokens

We want each row to represent a word from a tweet, rather than an entire tweet.

#separate tweet so that each row gets an individual word: unnest tokens
troll_tweets_untoken <- troll_tweets1 %>%
  unnest_tokens(word,content)
troll_tweets_untoken

4. Remove stopwords

#get rid of stopwords (the, and, etc.)
troll_tweets_cleaned <- troll_tweets_untoken %>%
  anti_join(stop_words)

## Joining, by = "word"

Take a look at the troll_tweets_cleaned dataset. Are there any other words/letters/numbers that we want to eliminate that weren’t taken care of by stop_words?

#get rid of http, https, t.co, rt, amp, single number digits, and singular letters
troll_tweets_cleaned <- troll_tweets_cleaned %>%
  filter(word != '1', word != '2', word != '3', word != '4', word != '5', word != '10', word != 'rt', word != 'amp', word != 'http', !(word %in% letters), word != 'https', word != 't.co')

5. Look at a subset of the tweets to see how often the top words appear.

troll_tweets_small <- troll_tweets_cleaned %>%
  count(word) %>%
  slice_max(order_by = n, n = 50)
ggplot(troll_tweets_small, aes(y = fct_reorder(word,n), x = n)) +
  geom_col()

6. Sentiment Analysis

1. Get the sentiments using the “bing” parameter (which classifies words into “positive” or “negative”)
2. Report how many positive and negative words there are in the dataset. Are there more positive or negative words, and why do you think this might be?

# look at sentiment
get_sentiments("bing")

# assign a sentiment to each word that has one associated
troll_tweets_sentiment <- troll_tweets_cleaned %>%
  inner_join(sentiments)

## Joining, by = "word"

# count the sentiments
troll_tweets_sentiment %>% 
  count(sentiment)

7. Using the troll_tweets_small dataset, make a wordcloud:

1. That is sized by the number of times that a word appears in the tweets
2. That is colored by sentiment (positive or negative)

# make a wordcloud where the size of the word is based on the number of times the word appears across the tweets
troll_tweets_small %>%
  with(wordcloud(word, n, max.words = 100))

# make a wordcloud colored by sentiment
troll_tweets_sentiment %>%
  acast(word ~ sentiment, fill = 0) %>%
  comparison.cloud(colors = c("red", "purple"),
                   max.words = 50)

## Using sentiment as value column: use value.var to override.

## Aggregation function missing: defaulting to length

Are there any words whose categorization as “positive” or “negative” surprised you? trump as positive was suprising but this was probably due to the verb ‘trump’

Projects

Read the project description on the moodle page. Talk to your group members about potential topics.

Task:

Write a short paragraph about ideas you have. If you already have some data sources in mind, you can link to those, but I’m more concerned with you having a topic that you’re interested in investigating right now.

Disease risk classification sounds very interesting to me. Dataset: https://www.kaggle.com/ronitf/heart-disease-uci

“Undoing” bias

Task:

Read this tweet thread by Deb Raji who you may remember from the Coded Bias film. Write a short paragraph that discusses at least one of the misconceptions.

The point made about how race and gender are the least obvious biases to detect was interesting. Since this is legally protected information, you can’t have this data and it’s probably hard to identify proxies for these in different datasets in different contexts. The paper about how racial categories was also interesting. It states that these categories are ill defined and the sample might be misprepresented when comparisons are made across different datasets that are using these poorly defined categories.